﻿Imports System.ServiceModel

Module ServerMod
    Friend WithEvents GameServer As New MPQService.GameServer
    Friend DisplayServerI As MPQService.DisplayServer
    Friend Games As New Dictionary(Of Integer, GameControl)
    Friend GUI As ServerForm
    Friend PND As PortNumbersDialog
    Friend WithEvents MainServer As ServiceHost
    Friend WithEvents LUpdateServer As ServiceHost
    Friend WithEvents UpdateServer As ServiceHost
    Friend WithEvents WebServer As Web.WebServiceHost
    Friend WithEvents DisplayServer As ServiceHost

    Friend SingleGameOnly As Boolean = False
    Friend SingleGameName As String = ""

    Friend MainContext As InstanceContext
    Friend DisplayContext As InstanceContext

    Friend ServerName As String
    Dim WithEvents UDPDiscovery As ServiceModel.Discovery.DiscoveryClient

    ''' <CommandLineArgs>
    ''' /a AutoStart. Causes server to start without displaying config screen (unless used with /-s) and auto minimizes
    ''' /-s Forces display of config screen
    ''' /s Prevents display of config screen
    ''' 
    ''' /m GameServer Port
    ''' /w WebServer Port
    ''' /u URI of Server
    ''' /n Server Name
    ''' /SINGLE Forces Single Game
    ''' /-SINGLE Prevents Single Game
    ''' 
    ''' /f Defines UsersAndTeams file
    ''' </CommandLineArgs>

    Sub Main()
        If My.Application.CommandLineArgs.Contains("/?") Then
            WriteHelp()
            Exit Sub
        End If

        'If Not IO.File.Exists("MPQServer.exe.config") Then
        '    Dim FS As New IO.FileStream("MPQServer.exe.config", IO.FileMode.Create)
        '    With Reflection.Assembly.GetExecutingAssembly().GetManifestResourceStream("MPQServer.App.config")
        '        Dim Buffer(.Length) As Byte
        '        .Read(Buffer, 0, .Length)
        '        FS.Write(Buffer, 0, .Length)
        '        FS.Close()
        '    End With
        '    IO.File.SetAttributes("MPQServer.exe.config", IO.FileAttributes.Hidden)
        'End If

        'AppDomain.CurrentDomain.SetData("APP_CONFIG_FILE", "MPQServer.exe.config")

        Application.EnableVisualStyles()

        GUI = New ServerForm
        PND = New PortNumbersDialog

        UDPDiscovery = New ServiceModel.Discovery.DiscoveryClient
        With My.Application.CommandLineArgs
            If Not .Contains("/a") And Not .Contains("/s") Or .Contains("/-s") Then
setup:          If Not PND.ShowDialog() = DialogResult.OK Then
                    Application.Exit()
                    Exit Sub
                End If
            End If
        End With

        ServerName = PND.ServerNameTB.Text

        If PND.PasswordCheckBox.Checked Then
            Dim sha1 As System.Security.Cryptography.SHA1 = System.Security.Cryptography.SHA1.Create()
            Dim hashData As Byte() = sha1.ComputeHash(Text.Encoding.[Default].GetBytes(InputBox("Please enter server password")))

            GameServer.ServerPassword = Convert.ToBase64String(hashData)
        End If

        If My.Application.CommandLineArgs.Contains("/a") Then
            GUI.minimized = True
        Else
            GUI.Show()
        End If



        Dim StartUpThread As New Threading.Thread(AddressOf StartUp)
        StartUpThread.Name = "Startup Thread"
        StartUpThread.Start()

        Try
            Application.Run()
        Catch ex As Exception When Debugger.IsAttached = False
            GUI.SetStatus("Error:")
            GUI.SetStatus(ex.Message)
            GUI.SetStatus("Please restart server")
        End Try
    End Sub

    Sub StartUp()
        Threading.Thread.Sleep(500)

        GUI.SetStatus("Enabling NetTcp Port Sharing...")
        Dim sc As New ServiceProcess.ServiceController("NetTcpPortSharing")

        Try
            If sc.Status = ServiceProcess.ServiceControllerStatus.Stopped Then sc.Start()
            If sc.Status = ServiceProcess.ServiceControllerStatus.Paused Then sc.Continue()
        Catch ex As Exception
            GUI.SetStatus("Error Starting NetTcp Port Sharing:")
            GUI.SetStatus(ex.Message)
        End Try

        Dim SingleInstance As Boolean
        If Debugger.IsAttached Then
            If Process.GetProcessesByName("MPQServer").Count + Process.GetProcessesByName("MPQServer.vshost").Count = 1 Then SingleInstance = True Else SingleInstance = False
        Else
            If Process.GetProcessesByName("MPQServer").Count = 1 Then SingleInstance = True Else SingleInstance = False
        End If

        If Not SingleInstance Then
            GUI.SetStatus("Waiting for NetTcpPortSharing to start...")
            Try
                sc.WaitForStatus(ServiceProcess.ServiceControllerStatus.Running, New TimeSpan(0, 5, 0))
            Catch ex As Exception
                GUI.SetStatus("Couldn't start NetTcpPortSharing:")
                GUI.SetStatus(ex.Message)
                GUI.SetStatus("You won't be able to run multiple servers on the same port!")
            End Try
        End If
        sc.Dispose()

CheckName: If Not ServerName = "" Then
            If NameInUse(ServerName) Then
                GUI.SetStatus("The Server Name is already in use. Name changed to " & ServerName)
                GoTo CheckName
            End If
            GUI.SetStatus("Name Check Complete")
            GUI.UpdateTitle("MPQ Server - " & ServerName)
        End If

        GUI.SetStatus("Starting Server", "Checking Config")

        If SingleGameOnly Then
            SingleGameName = InputBox("Enter Game Name")
        End If

        If Not ServerName = "" Then
            ServerName += "/"
            ServerName = ServerName.Replace(" ", "_")
        End If

        With My.Application.CommandLineArgs
            If .Contains("/f") Then : GameServer.InitializeServer(SingleGameOnly, SingleGameName, .Item(.IndexOf("/f") + 1))
            Else : GameServer.InitializeServer(SingleGameOnly, SingleGameName)
            End If
        End With

        Try
            GUI.SetStatus("Starting Server", "Creating Main Server")

            MainServer = New ServiceHost(GameServer, New Uri("net.tcp://" & PND.URITB.Text & ":" & PND.MainPortTB.Text & "/MPQ/Server/" & ServerName))
            GUI.SetStatus("Starting Server", "Creating Update Server")
            UpdateServer = New ServiceHost(New MPQService.UpdateServer, New Uri("net.tcp://" & PND.URITB.Text & ":" & PND.MainPortTB.Text & "/MPQ/Server/" & ServerName & "Update/"))
            If Not ServerName = "" Then
                'Legacy Update Server for older versions that don't know about names
                Try
                    LUpdateServer = New ServiceHost(New MPQService.UpdateServer, New Uri("net.tcp://" & PND.URITB.Text & ":" & PND.MainPortTB.Text & "/MPQ/Server/Update/"))
                Catch
                    'If it won't start - never mind!
                End Try
            End If
            GUI.SetStatus("Starting Server", "Creating Web Server")
            WebServer = New Web.WebServiceHost(New MPQService.WebServer(GameServer), New Uri("http://" & PND.URITB.Text & ":" & PND.WebPortTB.Text & "/MPQ/" & ServerName))
            GUI.SetStatus("Starting Server", "Creating Display Server")
            DisplayServerI = New MPQService.DisplayServer(GameServer)
            DisplayServer = New ServiceHost(DisplayServerI, New Uri("http://" & PND.URITB.Text & ":" & PND.WebPortTB.Text & "/MPQ/" & ServerName & "Display/"))

            MainServer.Description.Endpoints(0).Behaviors.Add(New MainClientBehaviors)
            Dim CB As New MPQService.GameServer.ClientBehavior(GameServer)
            MainServer.Description.Endpoints(0).Behaviors.Add(CB)
            AddHandler CB.SetStatus, AddressOf GUI.SetStatus
        Catch ex As Exception
            GUI.SetStatus("Couldn't create ServiceHosts:")
            GUI.SetStatus(ex.Message)
            Exit Sub
        End Try

        AddHandler MainServer.Faulted, AddressOf OnFault
        AddHandler MainServer.Closing, AddressOf GameServer.CloseServer

        Try
            GUI.SetStatus("Starting Server", "Starting Main Server")
            MainServer.Open()
            GUI.SetStatus("MainServer Started. Address:")
            GUI.SetStatus(MainServer.BaseAddresses(0).AbsoluteUri)
        Catch ex As Exception
            GUI.SetStatus("MainServer Failed to Start:")
            GUI.SetStatus(ex.Message)
        End Try
        Try
            GUI.SetStatus("Starting Server", "Starting Update Server")
            UpdateServer.Open()
            GUI.SetStatus("UpdateServer Started. Address:")
            GUI.SetStatus(UpdateServer.BaseAddresses(0).AbsoluteUri)
        Catch ex As Exception
            GUI.SetStatus("UpdateServer Failed to Start:")
            GUI.SetStatus(ex.Message)
        End Try
        If Not ServerName = "" Then
            Try
                LUpdateServer.Open()
            Catch ex As Exception
                'If it won't start - never mind!
            End Try
        End If
        Try
            GUI.SetStatus("Starting Server", "Starting Web Server")
            WebServer.Open()
            GUI.SetStatus("WebServer Started. Address:")
            GUI.SetStatus(WebServer.BaseAddresses(0).AbsoluteUri)
        Catch ex As Exception
            GUI.SetStatus("WebServer Failed to Start:")
            GUI.SetStatus(ex.Message)
        End Try
        Try
            GUI.SetStatus("Starting Server", "Starting Display Server")
            DisplayServer.Open()
            GUI.SetStatus("DisplayServer Started. Address:")
            GUI.SetStatus(DisplayServer.BaseAddresses(0).AbsoluteUri)
        Catch ex As Exception
            GUI.SetStatus("DisplayServer Failed to Start:")
            GUI.SetStatus(ex.Message)
        End Try
        GUI.SetStatus("Starting Server", "Finished")
    End Sub

    Sub WriteHelp()
        MsgBox("MPQ Server Command Line Options:" _
        & vbCr _
        & vbCr & "/a AutoStart. Causes server to start without displaying config screen (unless used with /-s) and auto minimizes" _
        & vbCr & "/-s Forces display of config screen" _
        & vbCr & "/s Prevents display of config screen" _
        & vbCr _
        & vbCr & "/m GameServer Port" _
        & vbCr & "/w WebServer Port" _
        & vbCr & "/u URI of Server" _
        & vbCr & "/n Server Name" _
        & vbCr & "/SINGLE Forces Single Game" _
        & vbCr & "/-SINGLE Prevents Single Game" _
        & vbCr _
        & vbCr & "/f Defines UsersAndTeams file")
    End Sub

    Function NameInUse(ByRef NameToCheck As String) As Boolean
        Dim findCriteria As New ServiceModel.Discovery.FindCriteria(GetType(MPQService.IServer))
        findCriteria.Duration = New TimeSpan(0, 0, 30)
        Dim CountdownThread As New Threading.Thread(AddressOf Countdown)
        CountdownThread.Start({"Checking Server Name", 30})
        For Each Endpoint As ServiceModel.Discovery.EndpointDiscoveryMetadata In UDPDiscovery.Find(findCriteria).Endpoints
            With Endpoint.Address.Uri
                Dim ServerName As String
                If Not .AbsoluteUri.EndsWith("/Server/") Then
                    ServerName = .AbsoluteUri.Remove(.AbsoluteUri.Length - 1)
                    ServerName = ServerName.Remove(0, ServerName.LastIndexOf("/") + 1)
                    ServerName = ServerName.Replace("_", " ")
                Else
                    ServerName = .AbsoluteUri
                End If
                If ServerName = NameToCheck Then
                    NameToCheck += "@" & My.Computer.Name
                    Return True
                End If
            End With
        Next
        Return False
    End Function

    Sub Countdown(ByVal Params())
        Dim Status As String = Params(0)
        Dim Time As Integer = Params(1)
        For i = Time To 0 Step -1
            GUI.SetStatus(Status, i)
            System.Threading.Thread.Sleep(990)
        Next
    End Sub

    Private Sub OnFault(ByVal Sender As Object, ByVal e As EventArgs)
        GUI.SetStatus("Service Faulted. Please restart server")
    End Sub

    Private Sub GameServer_GameReset(ByVal ID As Integer) Handles GameServer.GameReset
        Games(ID).EnableCtrlButton(True)
        Games(ID).CheckAllowHost(True)
    End Sub

    Private Sub GameServer_NewGame(ByVal ID As Integer, ByVal Name As String) Handles GameServer.NewGame
        GUI.Invoke(New Action(Of Integer, String)(AddressOf CreateNewGameControl), {ID, Name})
    End Sub

    Sub CreateNewGameControl(ByVal ID As Integer, ByVal Name As String)
        Dim Control As New GameControl(Name)
        If SingleGameOnly Then
            Control.AllowHost.Visible = False
        Else
            GUI.SetStatus("Added Game: " & Name)
        End If
        Games.Add(ID, Control)
        GUI.AddControl(Control)
        AddHandler Control.AllowHost.CheckedChanged, AddressOf AllowHost
        AddHandler Control.CtrlButton.Click, AddressOf ButtonClick
    End Sub

    Sub ButtonClick(ByVal Sender As Button, ByVal e As EventArgs)
        If Sender.Text = "Host" Then
            If SelectQuizDialog.ShowDialog = DialogResult.OK Then
                Sender.Enabled = False
                Sender.Text = "Start"
                Dim Params() = {Sender, SelectQuizDialog.ListBox1.SelectedItem}
                Dim HGT As New Threading.Thread(AddressOf _HostGame)
                HGT.Start(Params)
            End If
        Else
            GameServer.Games(GameServer.GameNames(CType(Sender.Parent, GameControl).GameName)).StartQuiz()
            Sender.Text = "Host"
            Sender.Enabled = False
        End If
    End Sub

    Sub _HostGame(ByVal Params())
        Dim GameControl As GameControl = Params(0).Parent
        Dim SelectedItem As String = Params(1)

        GameServer.Games(GameServer.GameNames(GameControl.GameName)).HostGame(SelectedItem)
        GameControl.EnableCtrlButton(True)
        GameControl.CheckAllowHost(False)
    End Sub

    Sub AllowHost(ByVal Sender As CheckBox, ByVal e As EventArgs)
        If Sender.Checked = True Then
            GameServer.Games(GameServer.GameNames(CType(Sender.Parent, GameControl).GameName)).GotHost(False)
        Else
            GameServer.Games(GameServer.GameNames(CType(Sender.Parent, GameControl).GameName)).GotHost(True)
        End If
    End Sub

    Private Sub GameServer_UpdateGameStatus(ByVal ID As Integer, ByVal Status As String, ByVal Detail As String) Handles GameServer.UpdateGameStatus
        Games(ID).SetStatus(Status, Detail)
    End Sub

    Friend Sub GameServer_EndGame(ByVal ID As Integer) Handles GameServer.EndGame
        If Not SingleGameOnly Then
            GUI.RemoveControl(Games(ID))
            GUI.SetStatus("Removed Game: " & Games(ID).GameName)
            Games.Remove(ID)
        End If
    End Sub

    Private Sub GameServer_UpdateGameScores(ByVal ID As Integer, ByVal Scores As System.Collections.Generic.SortedList(Of String, Long)) Handles GameServer.UpdateGameScores
        Try
            Games(ID).UpdateScores(Scores)
        Catch
        End Try
    End Sub

    Private Sub GameServer_UpdateServerStatus(ByVal Status As String, ByVal Detail As String) Handles GameServer.UpdateServerStatus
        GUI.SetStatus(Status, Detail)
    End Sub

    Private Sub GameServer_UserCreated(ByVal Name As String) Handles GameServer.UserCreated
        GUI.SetStatus("New user created: " & Name)
    End Sub

    Private Sub GameServer_UserLogin(ByVal Name As String) Handles GameServer.UserLogin
        GUI.SetStatus(Name & " has logged in")
    End Sub

    Private Sub GameServer_UserLogOut(ByVal Name As String) Handles GameServer.UserLogOut
        GUI.SetStatus(Name & " has logged out")
    End Sub
End Module

Public Class MainClientBehaviors
    Implements Dispatcher.IInstanceContextInitializer
    Implements Description.IEndpointBehavior

    Public Sub Initialize(ByVal instanceContext As System.ServiceModel.InstanceContext, ByVal message As System.ServiceModel.Channels.Message) Implements System.ServiceModel.Dispatcher.IInstanceContextInitializer.Initialize
        MainContext = instanceContext
    End Sub

    Public Sub AddBindingParameters(ByVal endpoint As System.ServiceModel.Description.ServiceEndpoint, ByVal bindingParameters As System.ServiceModel.Channels.BindingParameterCollection) Implements System.ServiceModel.Description.IEndpointBehavior.AddBindingParameters

    End Sub

    Public Sub ApplyClientBehavior(ByVal endpoint As System.ServiceModel.Description.ServiceEndpoint, ByVal clientRuntime As System.ServiceModel.Dispatcher.ClientRuntime) Implements System.ServiceModel.Description.IEndpointBehavior.ApplyClientBehavior

    End Sub

    Public Sub ApplyDispatchBehavior(ByVal endpoint As System.ServiceModel.Description.ServiceEndpoint, ByVal endpointDispatcher As System.ServiceModel.Dispatcher.EndpointDispatcher) Implements System.ServiceModel.Description.IEndpointBehavior.ApplyDispatchBehavior
        endpointDispatcher.DispatchRuntime.InstanceContextInitializers.Add(Me)
    End Sub

    Public Sub Validate(ByVal endpoint As System.ServiceModel.Description.ServiceEndpoint) Implements System.ServiceModel.Description.IEndpointBehavior.Validate

    End Sub
End Class

Public Class TraceWriter
    Inherits TraceListener

    Public Overloads Overrides Sub Write(ByVal message As String)
        
    End Sub

    Public Overloads Overrides Sub WriteLine(ByVal message As String)
        Dim TraceXML As New Xml.XmlDocument
        Try
            TraceXML.LoadXml(message)
        Catch
            Exit Sub
        End Try

        Dim Node As New TreeNode()

        For Each XMLNode As Xml.XmlNode In TraceXML.ChildNodes(0).ChildNodes 'TraceRecord Node
            Select Case XMLNode.Name
                Case "ExtendedData"
                    For Each XMLSubNode As Xml.XmlNode In XMLNode.ChildNodes
                        Select Case XMLSubNode.Name
                            Case "MessageHeaders"
                                For Each XmlSubSubNode As Xml.XmlNode In XMLSubNode.ChildNodes
                                    Select Case XmlSubSubNode.Name
                                        Case "a:Action"
                                            Node.Text += " " & XmlSubSubNode.InnerText
                                        Case "Action"
                                            Node.Text += " " & XmlSubSubNode.InnerText
                                        Case "ServerPassword"
                                            If XmlSubSubNode.InnerText = "" Then
                                                Node.Nodes.Add("Doesn't contain Server Password")
                                            Else
                                                Node.Nodes.Add("Contains Server Password")
                                            End If
                                    End Select
                                Next

                            Case "ConfigurationFileSource"
                                Node.Nodes.Add("File: " & XMLSubNode.InnerText)

                            Case "ServiceConfigurationInformation"
                                For Each XmlSubSubNode As Xml.XmlNode In XMLSubNode.ChildNodes
                                    Select Case XmlSubSubNode.Name
                                        Case "Endpoints"
                                            Dim EndpointsNode As TreeNode = Node.Nodes.Add("Endpoints")
                                            For Each XMLEndpointNode As Xml.XmlNode In XmlSubSubNode.ChildNodes
                                                Dim EndpointNode As New TreeNode
                                                For Each XmlEndpointSubNode As Xml.XmlNode In XMLEndpointNode.ChildNodes
                                                    Select Case XmlEndpointSubNode.Name
                                                        Case "Name"
                                                            EndpointNode.Text = XmlEndpointSubNode.InnerText
                                                        Case Else
                                                            EndpointNode.Nodes.Add(XmlEndpointSubNode.Name & ": " & XmlEndpointSubNode.InnerText)
                                                    End Select
                                                Next
                                                EndpointsNode.Nodes.Add(EndpointNode)
                                            Next

                                        Case "Host"

                                        Case Else
                                            Node.Nodes.Add(XmlSubSubNode.Name & ": " & XmlSubSubNode.InnerText)
                                    End Select
                                Next
                        End Select
                    Next

                Case "Description"
                    Node.Text = (XMLNode.InnerText)
            End Select
        Next

        If Not Node.Text = "" Then
            Try
                GUI.TracesToAdd.Enqueue(Node)
            Catch
            End Try
        End If
    End Sub

End Class
